program Project1;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Windows, Winsock, SysUtils;

const
  N = 100;

  srvhost = '127.0.0.1';
  srvport = 606;
  remhost = '127.0.0.1'; // '192.0.32.10';
  remport = 80;

  request1 = 'GET / HTTP/1.1'#10 + 'Accept: text/html, */*'#10 +
    'Accept-Language: en'#10 + 'Accept-Encoding: gzip, deflate'#10 +
    'User-Agent: Mozilla/10.0'#10 + 'Host: example.com'#10 +
    'Connection: Keep-Alive'#10 + 'Pragma: no-cache'#10 +
    'Accept-Language: en'#10#10;

type
  TSOCKS4_REQUEST = record
    ucVersion: byte;
    ucCommand: byte;
    wDestPort: word;
    dwDestIp: dword;
  end;

var
  WD: TWSAData;
  A: dword;
  H: array [0 .. N] of THandle;
  I: Integer;

procedure log(msg: ansistring);
begin
  WriteLn(msg);
end;

procedure Thread; stdcall;
var
  S: TSocket;
  A: sockaddr_in;
  R: TSOCKS4_REQUEST;
  C: array [0 .. 1024] of AnsiChar;

  procedure die(obituary: ansistring);
  begin
    WriteLn(obituary);
    CloseSocket(S);
    WSACleanup;
    ReadLn(obituary);
    ExitProcess(0);
  end;

begin
  S := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  A.sin_family := PF_INET;
  A.sin_port := htons(srvport);
  A.sin_addr.S_addr := inet_addr(srvhost);
  FillChar(A.sin_zero, sizeof(A.sin_zero), 0);
  if connect(S, A, sizeof(A)) <> 0 then
    die('---##connect');

  // Construct s4 header
  R.ucVersion := 4;
  R.ucCommand := 1;
  R.wDestPort := htons(remport);
  R.dwDestIp := inet_addr(remhost);
  // Send header to connect
  if send(S, R, sizeof(R), 0) = 0 then
    exit;
  // If not 90 then we give a shit, wtfk?
  recv(S, R, sizeof(R), 0);
  if R.ucCommand <> 90 then
    exit;

  // Transfers.. beginning of the end
  lstrcpyA(C, request1);
  if send(S, C, lstrlenA(C), 0) = 0 then
    exit;
  repeat
  until recv(S, C, sizeof(C), 0) = 0;
end;

begin
  log('---#startup');
  WSAStartup($101, WD);
  for I := 0 to N do
  begin
    log('---#connection: ' + IntToStr(N));
    H[I] := CreateThread(nil, 0, @Thread, nil, 0, A);
  end;
  for I := 0 to N do
  begin
    log('---#waiting:' + IntToStr(N));
    WaitForSingleObject(H[I], 1000);
  end;
  WSACleanup;
  log('---succeed');

end.
